#!/usr/bin/perl -w
use warnings;
use strict;
use Getopt::Long qw(:config gnu_getopt);
use Storable qw(retrieve);

my $INDENT = ' ' x 4;

my ($input, $output, $reference, $help);
my %options = (
    'input|i=s'     => \$input,
    'output|o=s'    => \$output,
    'reference|r=s' => \$reference,
    'help|h|?'      => \$help,
);
error(-1, "Please run the program with option '--help'.") unless GetOptions(%options);
usage() if $help;
$input = $ARGV[0] if (!defined($input) && @ARGV == 1);
error(-1, "You must specify input file.") unless defined($input);
open INPUT, '<', $input or error(2, "cannot open input: $input: $!");
if (defined($output)) {
    open OUTPUT, '>', $output or error(3, "cannot open output: $output: $!");
    select OUTPUT;
}

# =====================================================================
my %dump_subs = (
    ARRAY => \&dump_array,
    HASH  => \&dump_hash,
    ''    => \&dump_scalar,
    CODE  => \&dump_code,
    '*'   => \&dump_scalar,
);
my $data = retrieve $input or error(-1, "$input: cannot retrieve Storable data");
my $ref_code = '$data' . $reference;
my $ref  = eval $ref_code or error(-1, "cannot eval the reference: $@");
if (exists($dump_subs{ref($ref)})) {
    $dump_subs{ref($ref)}->($ref);
} else {
    $dump_subs{'*'}->($ref);
}
# =====================================================================

close INPUT;
close OUTPUT if defined($output);

# =====================================================================

sub dump_array {
    my $ref = shift;
    print "DUMP: $ref\n";
    for my $i (0 .. $#{$ref}) {
        printf "${INDENT}[%3d] |%s|\n", $i, "$ref->[$i]";
    }
}

sub dump_hash {
    my $ref = shift;
    print "DUMP: $ref\n";
    for my $key (sort {; $a cmp $b; } keys(%$ref)) {
        printf "${INDENT}{%20s} |%s|\n", $key, "$ref->{$key}";
    }
}

sub dump_scalar {
    my $ref = shift;
    print "DUMP: $ref\n";
    print "${INDENT}|$ref|\n";
}

sub usage {
    (my $PROG = $0) =~ s/.*[\\\/]//;
    print STDERR <<"EO_USAGE";
usage:
    $PROG [ OPTIONS ] -i INPUT -o OUTPUT
options:
    -i, --input=FILE   specify input file
    -o, --output=FILE  specify output file
    -h, --help         print this help screen
EO_USAGE
    exit 0 unless defined($_[0]);
    1;
}

sub error {
    my $exit_status = shift;
    my ($package, $filename, $line, $subroutine) = caller();
    $subroutine = 'main' unless defined($subroutine);
    print STDERR "$subroutine: ", @_, "\n";
    print STDERR "from: $filename +$line\n";
    exit $exit_status;
}

sub message {
    print STDERR @_, "\n";
    return 1;
}
